Attribute VB_Name = "MDocumentor"
''' VBA Code Documentor 5.0 by Rob Bovey, copyright 1996-2004,
''' all rights reserved. May be redistributed for free,
''' but may not be sold without the author's explicit permission.
Option Explicit
Option Private Module

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''' Comments:   Enumerates the VBComponents of the project and stores the
'''             number of each kind. Also calls the procedure to enumerate
'''             the contents of each component code module.
'''
''' Arguments:  wkbTarget   [in] The workbook being documented.
'''             wksDetail   [in] The detail worksheet in the report workbook
'''                         that we'll be loading with data about the project.
'''
''' Returns:    Boolean     True on success, False on error.
'''
''' Date        Developer           Action
''' --------------------------------------------------------------------------
''' 01/11/00    Rob Bovey           Created
''' 06/09/04    Rob Bovey           Updated coding conventions.
'''
Public Function bEnumerateComponents(ByRef wkbTarget As Excel.Workbook, ByRef wksDetail As Excel.Worksheet) As Boolean

    Dim lComponentIndex As Long
    Dim szComponentName As String
    Dim cmpComponent As VBIDE.VBComponent
    Dim cmpComponents As VBIDE.VBComponents

    If gbDEBUG_MODE Then
        On Error GoTo 0
    Else
        On Error GoTo ErrorHandler
    End If
    
    Set cmpComponents = wkbTarget.VBProject.VBComponents
    
    ReDim guComponentSpecs(1 To cmpComponents.Count)
    lComponentIndex = 1

    ''' Loop the VBComponents collection, count each type and call the procedure documentor.
    For Each cmpComponent In cmpComponents
        
        szComponentName = cmpComponent.Name
        
        Application.StatusBar = szSubstituteText(gszSTATUS_ENUMERATING_CONTENTS, szComponentName)
        
        guComponentSpecs(lComponentIndex).szName = szComponentName
        Set guComponentSpecs(lComponentIndex).modCodeModule = cmpComponent.CodeModule
    
        ''' Increment the proper global counter variable and load the component type name.
        Select Case cmpComponent.Type
        
            Case vbext_ct_StdModule
                guProjectInfo.lCodeModules = guProjectInfo.lCodeModules + 1
                guComponentSpecs(lComponentIndex).szType = "Standard Module"
                
            Case vbext_ct_Document
                guProjectInfo.lDocObjects = guProjectInfo.lDocObjects + 1
                guComponentSpecs(lComponentIndex).szType = "Document Object"
                
            Case vbext_ct_MSForm
                guProjectInfo.lUserForms = guProjectInfo.lUserForms + 1
                guComponentSpecs(lComponentIndex).szType = "UserForm"
                
            Case vbext_ct_ClassModule
                guProjectInfo.lClassModules = guProjectInfo.lClassModules + 1
                guComponentSpecs(lComponentIndex).szType = "Class Module"
            
        End Select
    
        ''' Document the procedures in each VBComponent.
        If Not bEnumerateProcedures(guComponentSpecs(lComponentIndex), wksDetail) Then Err.Raise glHANDLED_ERROR

        ''' Add the component counts just enumerated to the global count total.
        guProjectInfo.lProcedures = guProjectInfo.lProcedures + guComponentSpecs(lComponentIndex).lProcedures
        guProjectInfo.lDLLDeclarations = guProjectInfo.lDLLDeclarations + guComponentSpecs(lComponentIndex).lDLLDeclarations
        guProjectInfo.lCodeLines = guProjectInfo.lCodeLines + guComponentSpecs(lComponentIndex).lCodeLines
        
        ''' Get the file size for this component.
        guComponentSpecs(lComponentIndex).dFileSize = dGetTextFileSize(cmpComponent)
    
        lComponentIndex = lComponentIndex + 1
        
    Next cmpComponent

    bEnumerateComponents = True
    Exit Function

ErrorHandler:
    If Len(gszErrMsg) = 0 Then gszErrMsg = Err.Description
    If Err.Number <> glHANDLED_ERROR Then gszErrMsg = gszErrMsg & " (bEnumerateComponents)"
    bEnumerateComponents = False
End Function


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''' Comments:   Creates the project summary report.
'''
''' Arguments:  wksSummary      [in] The summary report worksheet.
'''
''' Returns:    Boolean         True on success, False on error.
'''
''' Date        Developer           Action
''' --------------------------------------------------------------------------
''' 01/11/00    Rob Bovey           Created
''' 06/09/04    Rob Bovey           Modifed the file size report so that it's
'''                                 a true number with a custom number format
'''                                 that displays it a #,#0.0 K.
'''
Public Function bSummaryReportGenerator(ByRef wksSummary As Excel.Worksheet) As Boolean
    
    Dim lCount As Long
    Dim lRowOffset As Long
    Dim rngTableTop As Excel.Range
    
    If gbDEBUG_MODE Then
        On Error GoTo 0
    Else
        On Error GoTo ErrorHandler
    End If
    
    ''' Enter the report title.
    wksSummary.Range("Title").Value = szSubstituteText(gszSUMMARY_TITLE, guProjectInfo.szBookName, Format$(Now(), "mm/dd/yyyy"))
        
    ''' Enter the project component summary info.
    wksSummary.Range("StandardModules").Value = guProjectInfo.lCodeModules
    wksSummary.Range("ClassModules").Value = guProjectInfo.lClassModules
    wksSummary.Range("UserForms").Value = guProjectInfo.lUserForms
    wksSummary.Range("DocumentObjects").Value = guProjectInfo.lDocObjects
    
    ''' Enter the project code summary info.
    wksSummary.Range("Procedures").Value = guProjectInfo.lProcedures
    wksSummary.Range("DLLs").Value = guProjectInfo.lDLLDeclarations
    wksSummary.Range("LinesOfCode").Value = guProjectInfo.lCodeLines

    ''' Enter the by component info.
    lRowOffset = 1
    Set rngTableTop = wksSummary.Range("SummaryTableTop")
    
    For lCount = LBound(guComponentSpecs) To UBound(guComponentSpecs)
        rngTableTop.Offset(lRowOffset, 0).Value = guComponentSpecs(lCount).szName
        rngTableTop.Offset(lRowOffset, 1).Value = guComponentSpecs(lCount).szType
        rngTableTop.Offset(lRowOffset, 2).Value = guComponentSpecs(lCount).lProcedures
        rngTableTop.Offset(lRowOffset, 3).Value = guComponentSpecs(lCount).lDLLDeclarations
        rngTableTop.Offset(lRowOffset, 4).Value = guComponentSpecs(lCount).lCodeLines
        With rngTableTop.Offset(lRowOffset, 5)
            .Value = guComponentSpecs(lCount).dFileSize
            .NumberFormat = "#,#0.0 ""K"""
        End With
        lRowOffset = lRowOffset + 1
    Next lCount
    
    ''' Apply and necessary formatting.
    wksSummary.UsedRange.EntireColumn.AutoFit
    rngTableTop.EntireColumn.ColumnWidth = 25
    SortComponentSummary rngTableTop
    
    bSummaryReportGenerator = True
    Exit Function

ErrorHandler:
    If Len(gszErrMsg) = 0 Then gszErrMsg = Err.Description
    If Err.Number <> glHANDLED_ERROR Then gszErrMsg = gszErrMsg & " (bSummaryReportGenerator)"
    bSummaryReportGenerator = False
End Function


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''' Comments:   Enumerates the contents of a code module.
'''
''' Arguments:  guComponentSpecs    [in] A type structure holding information
'''                                 about the CodeModule object to be enumerated.
'''             wksDetail           [in] The detail worksheet in the report workbook.
'''
''' Returns:    Boolean             True on success, False on error.
'''
''' Date        Developer           Action
''' --------------------------------------------------------------------------
''' 01/11/00    Rob Bovey           Created
''' 06/09/04    Rob Bovey           Updated coding conventions.
'''
Private Function bEnumerateProcedures(ByRef guComponentSpecs As COMPONENT_SPECS, ByVal wksDetail As Excel.Worksheet) As Boolean

    Dim rngDetailTop As Excel.Range     ''' The top left cell in the detail worksheet.
    Dim rngStartOutline As Excel.Range  ''' The range directly below the module name where the outline starts.
    Dim lCodeLine As Long
    Dim lDetailLineCount As Long        ''' Determines if there are enough detail lines to outline this procedure.
    Dim szProcName As String            ''' The name of the current procedure.
    Dim szPrevProcName As String        ''' The name of the most recent procedure found.
    Dim szLine As String                ''' Holds the current line of code.
    Dim modCurrentModule As VBIDE.CodeModule
    
    If gbDEBUG_MODE Then
        On Error GoTo 0
    Else
        On Error GoTo ErrorHandler
    End If
    
    Set modCurrentModule = guComponentSpecs.modCodeModule
    Set rngDetailTop = wksDetail.Range("A1")
    
    With rngDetailTop.Offset(glDetailOffset, 0)
        .Value = modCurrentModule.Parent.Name
        .Font.Bold = True
        Set rngStartOutline = .Offset(1, 0) ''' The cell at which the outlining will start.
    End With

    glDetailOffset = glDetailOffset + 1
    
    For lCodeLine = 1 To modCurrentModule.CountOfLines
        
        ''' Get the next code line.
        szLine = Trim$(modCurrentModule.Lines(lCodeLine, 1))
        
        ''' Make sure that it's a line of code and not a comment or blank line.
        If Len(szLine) > 0 Then
        
            If Not bIsCommentLine(szLine) Then
            
                ''' Increment the code line count for this component.
                guComponentSpecs.lCodeLines = guComponentSpecs.lCodeLines + 1
                
                ''' Get the current procedure name if there is one.
                szProcName = szGetProcName(lCodeLine, modCurrentModule)
                
                If Len(szProcName) = 0 Then    ''' We're in the declarations section.
                    
                    ''' Look for Options settings.
                    If StrComp(Left$(szLine, 6), "Option", vbTextCompare) = 0 Then
                        rngDetailTop.Offset(glDetailOffset, 0).Value = szLine
                        glDetailOffset = glDetailOffset + 1
                        lDetailLineCount = lDetailLineCount + 1
                    ''' Look for DLL declarations.
                    ElseIf InStr(szLine, " Function ") > 0 Or InStr(szLine, " Sub ") > 0 Then
                        rngDetailTop.Offset(glDetailOffset, 0).Value = szLine
                        guComponentSpecs.lDLLDeclarations = guComponentSpecs.lDLLDeclarations + 1
                        glDetailOffset = glDetailOffset + 1
                        lDetailLineCount = lDetailLineCount + 1
                    End If
                
                ''' We got a procedure name and it's different from the previous procedure name.
                ElseIf Len(szProcName) > 0 And StrComp(szProcName, szPrevProcName, vbTextCompare) <> 0 Then
                    
                    ''' Add the procedure name to the detail sheet.
                    If StrComp(Right$(szLine, 2), gszCONTINUED) = 0 Then
                        ''' This function will increment lCodeLine to the line after the continued line ends.
                        rngDetailTop.Offset(glDetailOffset, 0).Value = szReassembleLine(szLine, lCodeLine, modCurrentModule)
                    Else
                        rngDetailTop.Offset(glDetailOffset, 0).Value = szStripEndOfLineComments(szLine)
                    End If
                    
                    guComponentSpecs.lProcedures = guComponentSpecs.lProcedures + 1
                    szPrevProcName = szProcName
                    glDetailOffset = glDetailOffset + 1
                    lDetailLineCount = lDetailLineCount + 1
                    
                End If
                
            End If
            
        End If
        
    Next lCodeLine

    glDetailOffset = glDetailOffset + 1
    
    ''' Outline the module listing if it has more than one procedure.
    If lDetailLineCount > 1 Then
        wksDetail.Range(rngStartOutline, rngStartOutline.End(xlDown)).Rows.Group
    End If
    
    bEnumerateProcedures = True
    Exit Function

ErrorHandler:
    If Len(gszErrMsg) = 0 Then gszErrMsg = Err.Description
    If Err.Number <> glHANDLED_ERROR Then gszErrMsg = gszErrMsg & " (bEnumerateProcedures)"
    bEnumerateProcedures = False
End Function


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''' Comments:   This procedure determines whether the line passed to it is
'''             a comment line or a code line.
'''
''' Arguments:  szInputLine     [in] The line to check.
'''
''' Returns:    Boolean         True if szLine is a comment, False if it isn't.
'''
''' Date        Developer           Action
''' --------------------------------------------------------------------------
''' 12/08/98    Rob Bovey           Created
''' 06/09/04    Rob Bovey           Updated coding conventions.
'''
Private Function bIsCommentLine(ByRef szInputLine As String) As Boolean

    Dim lChar As Long
    
    ''' If the first character is a single quote, it's a comment.
    If Left$(szInputLine, 1) = gszSQ Then
        bIsCommentLine = True
    ''' If the first three letters are "Rem", then we need to look further.
    ElseIf Left$(szInputLine, 3) = gszREM Then
        
        ''' If those are the only 3 characters then it's a comment
        If Len(szInputLine) = 3 Then
            bIsCommentLine = True
        Else
            ''' Otherwise we need to check the 4th character.
            lChar = Asc(Mid$(szInputLine, 4, 1))
            Select Case lChar
                Case 48 To 57, 65 To 90, 95, 97 To 122
                    ''' These are all valid procedure name characters, line is not a comment.
                    bIsCommentLine = False
                Case Else
                    bIsCommentLine = True
            End Select
        End If
    
    Else
        bIsCommentLine = False
    End If

End Function

